home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / source / QF Source / QF.SPCLWRDS2.S < prev    next >
Text File  |  1995-03-06  |  12KB  |  394 lines
  1. :OK LDA #$20 ; JSR IFSUB (borrow it since it's same)
  2.  JSR OUTBYTE
  3.  LDA #IFSUB
  4.  JSR OUTBYTE
  5.  LDA #/IFSUB
  6.  JSR OUTBYTE
  7.  
  8.  LDA #$D0 ; BNE (three bytes ahead)
  9.  JSR OUTBYTE
  10.  LDA #$03
  11.  JSR OUTBYTE
  12.  
  13.  LDA #$4C ; JMP (marker location)
  14.  JSR OUTBYTE
  15.  JSR POPCOMP
  16.  STX TEMP
  17.  TYA
  18.  JSR OUTBYTE
  19.  LDA TEMP
  20.  JMP OUTBYTE
  21.  
  22. *
  23. * Word "while" - part of BEGIN-WHILE-REPEAT
  24. *
  25.  
  26. WORD22 ASC 'while '
  27.  DW WHILE
  28.  
  29. WHILE BRK  ; Special executable compiler code
  30.  
  31.  JSR POPCOMP ; Make sure we're in compiler state $0004
  32.  CPY #$04
  33.  BEQ :OK
  34.  
  35.  LDA #$10 ; "while without begin"
  36.  JMP PRTERR
  37.  
  38. :OK LDA #$20 ; JSR IFSUB
  39.  JSR OUTBYTE
  40.  LDA #IFSUB
  41.  JSR OUTBYTE
  42.  LDA #/IFSUB
  43.  JSR OUTBYTE
  44.  
  45.  LDA #$D0 ; BNE (three bytes ahead)
  46.  JSR OUTBYTE
  47.  LDA #$03
  48.  JSR OUTBYTE
  49.  
  50.  LDA #$4C ; JMP (out of loop - patch area)
  51.  JSR OUTBYTE
  52.  
  53.  LDY COUTPUT ; Push patch area onto compiler stack
  54.  LDX COUTPUT+1
  55.  JSR PUSHCOMP
  56.  
  57.  LDA #$00 ; Finish off JMP instruction
  58.  JSR OUTBYTE
  59.  JSR OUTBYTE
  60.  
  61.  LDY #$05 ; Set compiler mode $0005
  62.  LDX #$00
  63.  JMP PUSHCOMP
  64.  
  65. *
  66. * Word "repeat" - part of BEGIN-WHILE-REPEAT
  67. *
  68.  
  69. WORD23 ASC 'repeat '
  70.  DW REPEAT
  71.  
  72. REPEAT BRK ; Special executable compiler word
  73.  
  74.  JSR POPCOMP ; Make sure we're in compiler state $0005
  75.  CPY #$05
  76.  BEQ :OK
  77.  
  78.  LDA #$11 ; "repeat without begin-while"
  79.  JMP PRTERR
  80.  
  81. :OK LDA #$4C ; JMP (back to beginning)
  82.  JSR OUTBYTE
  83.  
  84.  JSR POPCOMP ; Pop patch area out of loop
  85.  STY PNTR2
  86.  STX PNTR2+1
  87.  
  88.  JSR POPCOMP ; Pop marked area for beginning
  89.  STX TEMP ;   and finish off JMP
  90.  TYA
  91.  JSR OUTBYTE
  92.  LDA TEMP
  93.  JSR OUTBYTE
  94.  
  95.  LDA COUTPUT ; Patch area for out of loop
  96.  STA (PNTR2)
  97.  LDA COUTPUT+1
  98.  LDY #$01
  99.  STA (PNTR2),Y
  100.  
  101.  RTS
  102.  
  103. *
  104. * Subroutine used by ." and lit"
  105. *
  106.  
  107. STROUT STA TEMP2
  108.  STX TEMP3
  109.  JSR SKIP2SPC ; Skip to string
  110.  
  111.  LDA (WORDPNTR)
  112.  CMP #$0D
  113.  BEQ :ERROR
  114.  
  115.  INC WORDPNTR
  116.  BNE :SKIPINC
  117.  INC WORDPNTR+1
  118.  
  119. :SKIPINC LDA (WORDPNTR)
  120.  CMP #$0D
  121.  BEQ :ERROR
  122.  
  123.  LDY #$FF ; Look for ending quote
  124. :LOOP INY
  125.  LDA (WORDPNTR),Y
  126.  CMP #$0D
  127.  BEQ :ERROR
  128.  CMP TEMP3 ; Delimiter
  129.  BNE :LOOP
  130.  
  131.  STY TEMP ; Save string length
  132.  BIT TEMP2
  133.  BPL :NOCOUNT
  134.  TYA
  135.  JSR OUTBYTE
  136.  
  137. :NOCOUNT TYA ; Output string
  138.  TAX
  139.  LDY #$00
  140. :LOOP2 LDA (WORDPNTR),Y
  141.  JSR OUTBYTE
  142.  INY
  143.  DEX
  144.  BNE :LOOP2
  145.  
  146.  BIT TEMP2 ; Null-terminate if necessary
  147.  BMI :NONULL
  148.  TXA
  149.  JSR OUTBYTE
  150.  
  151. :NONULL LDA TEMP ; Update WORDPNTR
  152.  SEC
  153.  ADC WORDPNTR
  154.  STA WORDPNTR
  155.  BCC :SKPINC2
  156.  INC WORDPNTR+1
  157.  
  158. :SKPINC2 RTS
  159.  
  160. :ERROR LDA #$0C ; "No ending quote found for expression"
  161.  JMP PRTERR
  162.  
  163. *
  164. * Word /."/ - Print out a text string
  165. *
  166.  
  167. WORD24 ASC '.'
  168.  ASC '"'
  169.  ASC ' '
  170.  DW PRDQUOTE
  171.  
  172. PRDQUOTE BRK ; Special executable compiler word
  173.  
  174.  LDA #$20 ; JSR MSGOUT
  175.  JSR OUTBYTE
  176.  LDA #MSGOUT
  177.  JSR OUTBYTE
  178.  LDA #/MSGOUT
  179.  JSR OUTBYTE
  180.  
  181.  LDA #$00
  182.  LDX #$22
  183.  JMP STROUT
  184.  
  185. :ERROR LDA #$0C ; "No ending quote found for .""
  186.  JMP PRTERR
  187.  
  188. *
  189. * Word /"/ - End of print string
  190. *
  191.  
  192. WORD25 ASC '" '
  193.  DW QUOTE
  194.  
  195. QUOTE BRK ; Special executable compiler word
  196.  
  197.  LDA #$19 ; /End quote without ."/
  198.  JMP PRTERR
  199.  
  200. *
  201. * Word "string" - compiles counted string literal
  202. *                   into dictionary
  203. *
  204.  
  205. WORD26 ASC 'string '
  206.  DW STRING
  207.  
  208. STRING BRK ; Special executable compiler word
  209.  
  210.  LDA #$20 ; JSR STRSUB
  211.  JSR OUTBYTE
  212.  LDA #STRSUB
  213.  JSR OUTBYTE
  214.  LDA #/STRSUB
  215.  JSR OUTBYTE
  216.  
  217.  LDA #$00
  218.  LDX #$7E ; Tilde
  219.  JMP STROUT
  220.  
  221. *
  222.  
  223. STRSUB PLA
  224.  STA WORDPNTR
  225.  PLA
  226.  STA WORDPNTR+1
  227.  
  228.  LDY #$01 ; Output variable's name
  229. :LOOP LDA (WORDPNTR),Y
  230.  BEQ :EOL
  231.  JSR OUTBYTE
  232.  INY
  233.  BRA :LOOP
  234.  
  235. :EOL TYA
  236.  CLC
  237.  ADC WORDPNTR
  238.  TAX
  239.  LDA WORDPNTR+1
  240.  ADC #$00
  241.  PHA
  242.  PHX
  243.  RTS
  244.  
  245. *
  246. * Word /lit"/ - compiles counted string, returns address
  247. *
  248.  
  249. WORD27 ASC 'lit'
  250.  HEX 22
  251.  ASC ' '
  252.  DW LITQUOTE
  253.  
  254. LITQUOTE BRK ; Special executable compiler word
  255.  
  256.  LDA COUTPUT
  257.  CLC
  258.  ADC #$09
  259.  STA PNTR
  260.  LDA COUTPUT+1
  261.  ADC #$00
  262.  STA PNTR+1
  263.  
  264.  LDA #$A0 ; LDY #string
  265.  JSR OUTBYTE
  266.  LDA COUTPUT
  267.  LDA PNTR
  268.  JSR OUTBYTE
  269.  
  270.  LDA #$A2 ; LDX #/string
  271.  JSR OUTBYTE
  272.  LDA PNTR+1
  273.  JSR OUTBYTE
  274.  
  275.  LDA #$20 ; JSR PUSHDATA
  276.  JSR OUTBYTE
  277.  LDA #PUSHDATA
  278.  JSR OUTBYTE
  279.  LDA #/PUSHDATA
  280.  JSR OUTBYTE
  281.  
  282.  LDA #$80 ; BRA opcode
  283.  JSR OUTBYTE
  284.  LDA COUTPUT
  285.  STA PNTR2
  286.  LDA COUTPUT+1
  287.  STA PNTR2+1
  288.  LDA #$00
  289.  JSR OUTBYTE
  290.  
  291.  LDA #$80 ; Output string
  292.  LDX #$22 ; Double quote
  293.  JSR STROUT
  294.  
  295.  LDA TEMP
  296.  INC
  297.  STA (PNTR2)
  298.  RTS
  299.  
  300. *
  301. * Word "(" - Start of comment
  302. *
  303.  
  304. WORD28 ASC '( '
  305.  DW LEFTPAR
  306.  
  307. LEFTPAR BRK ; Special executable compiler word
  308.  
  309.  LDY #$FF ; Find right parentheses
  310. :LOOP INY
  311.  LDA (WORDPNTR),Y
  312.  CMP #$0D
  313.  BEQ :ERROR
  314.  CMP #')'
  315.  BNE :LOOP
  316.  
  317.  INY ; Move word text pointer past
  318.  TYA ;   right parentheses
  319.  CLC
  320.  ADC WORDPNTR
  321.  STA WORDPNTR
  322.  BNE :SKIPINC
  323.  INC WORDPNTR+1
  324. :SKIPINC RTS
  325.  
  326. :ERROR JMP PRTERR ; "No matching right parentheses
  327.  ;    for comment"
  328. ; (Accumulator is already $0D)
  329.  
  330. *
  331. * Word ")" - End of comment
  332. *
  333.  
  334. WORD29 ASC ') '
  335.  DW RIGHTPAR
  336.  
  337. RIGHTPAR LDA #$1A ; "Right parentheses without matching
  338.  JMP PRTERR ;    left parentheses"
  339.  
  340. *
  341. * Word "'" - Throw address of next word on stack
  342. *
  343.  
  344. WORD30 HEX 27
  345.  ASC ' '
  346.  DW TICK
  347.  
  348. TICK BRK ; Special executable compiler word
  349.  
  350.  JSR SKIP2SPC ; Move pointer to next word
  351.  JSR SKIPSPCS
  352.  
  353.  LDA #$20 ; JSR TICKSUB
  354.  JSR OUTBYTE
  355.  LDA #TICKSUB
  356.  JSR OUTBYTE
  357.  LDA #/TICKSUB
  358.  JSR OUTBYTE
  359.  
  360.  JSR TEXTOUT ; Output word text
  361.  
  362.  LDA #' ' ; Space-terminate text
  363.  JSR OUTBYTE
  364.  
  365.  JMP SKIP2SPC ; Move pointer past word
  366.  
  367. *
  368.  
  369. TICKSUB PLA ; Fetch text address
  370.  STA WORDPNTR
  371.  PLA
  372.  STA WORDPNTR+1
  373.  
  374.  INC WORDPNTR
  375.  BNE :SKIPINC
  376.  INC WORDPNTR+1
  377.  
  378. :SKIPINC JSR CALCHASH ; Calculate hash of text
  379.  JSR CHKWORD ; Look it up
  380.  BCC :ERROR
  381.  
  382.  LDY PNTR ; Throw address of word on stack
  383.  LDX PNTR+1
  384.  JSR PUSHDATA
  385.  
  386.  JMP RESUME ; Resume execution after text
  387.  
  388. :ERROR LDA #07 ; "Word not found"
  389.  JMP PRTERR
  390.  
  391. ********************************
  392. * End special compiler words 2
  393. ********************************
  394.